home *** CD-ROM | disk | FTP | other *** search
/ The Original Shareware 1.1 / The Original Shareware (WeMake CDs)(Volume 1.1)(CDs, Inc)(1993).iso / 18 / fpc103.zip / TIMESTUF.SEQ < prev    next >
Text File  |  1988-06-30  |  2KB  |  58 lines
  1. \ TIMESTUF.SEQ          More words associated with timing       Tom Zimmer
  2.  
  3. : SEC-ELAPSED   ( --- N1 )    \ RETURN ELAPSED SECONDS < 18 HRS
  4.                 TIME-ELAPSED B>SEC ; ( -- N1 )
  5.  
  6. : 10TH-ELAPSED  ( --- N1 )
  7.                 TIME-ELAPSED 0 100 UM/MOD DROP 10 UM/MOD NIP ;
  8.  
  9. DEFER PAUSE-FUNC        ' NOOP IS PAUSE-FUNC
  10.  
  11. : SECONDS       ( N1 --- )   \ PAUSE FOR N1 SECONDS
  12.                 STIME 2@ >R >R >R TIME-RESET
  13.                 BEGIN   PAUSE  PAUSE-FUNC
  14.                         R@ SEC-ELAPSED > 0=
  15.                 UNTIL   r>drop R> R> STIME 2! ;
  16.  
  17. : TENTHS        ( N1 --- )       \ PAUSE FOR N1 SECONDS
  18.                 STIME 2@ >R >R >R TIME-RESET
  19.                 BEGIN   PAUSE  PAUSE-FUNC
  20.                         R@ 10TH-ELAPSED > 0=
  21.                 UNTIL   r>drop R> R> STIME 2! ;
  22.  
  23. : MINUTES       ( N1 --- )   \ PAUSE FOR N1 MINUTES
  24.                 0 MAX   0 ?DO   60 SECONDS      LOOP ;
  25.  
  26. : HOURS         ( N1 --- )       \ PAUSE FOR N1 HOURS
  27.                 0 MAX   0 ?DO   60 MINUTES      LOOP ;
  28.  
  29. : 0COMPILER     ( --- )
  30.                 TOTALLINES OFF
  31.                 TIME-RESET ;
  32.  
  33. : .COMPSTAT     ( --- )
  34.                 cr .elapsed
  35.                 cr ." Total lines compiled  = " totallines @ 5 u.r
  36.                 cr ." Compiled lines/minute = "
  37.                 totallines @ time-elapsed over 32000 u> or
  38.                 ABORT" Too much time has elapsed to calculate LPM"
  39.                 >R 60 10000 R@ */MOD
  40.                 10 * SWAP DUP 10 >
  41.                 IF      >R 100 100 100 R> R> SWAP */ */
  42.                         10 /MOD  SWAP 4 > IF 1+ THEN +
  43.                 ELSE    r>drop DROP
  44.                 THEN    2DUP 100 / SWAP 100 / * 3276 >
  45.                 IF      10 / 1000 */ 10 *D 5 D.R
  46.                 ELSE    1000 */ 5 u.R
  47.                 THEN    ;
  48.  
  49. : TILLKEY       ( N1 --- )      \ WAIT UP TO N1 SECONDS FOR A KEY THEN GO ON.
  50.                 KEY?    IF  DROP EXIT  THEN     \ LEAVE IF KEY PRESSED
  51.                 CR ."  Waiting, press SPACEBAR to continue.."
  52.                 0 MAX 0
  53.                 ?DO     KEY?    ?LEAVE
  54.                         1 SECONDS
  55.                 LOOP    KEY?
  56.                 IF      KEY 3 = ABORT" Quitting " THEN ;
  57.  
  58.